home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 001-025 / scopedisk9 / mickey / mouse factory < prev    next >
Text File  |  1995-03-18  |  16KB  |  797 lines
  1. ' MICKEY'S FACTORY.  WRITTEN FOR HOLLY (3) 1-16-88 BY MIKE MEAD.
  2. ' 2112 COVERED WAGON DRIVE   PLANO, TEXAS  75074
  3. CLEAR ,25000
  4. CLEAR ,50000&
  5. OPTION BASE 0
  6. DIM MICKEY%(203,5),BOX%(243,2),HOOK%(193),RL%(153),RR%(153)
  7. DIM LL%(153),TOPBOX%(513),MIDBOX%(513),BOTBOX%(513),TBOX%(853)
  8. DIM MBOX%(853),BBOX%(853),BACKGROUND%(300),BLUE%(100)
  9. DIM GEARS%(263),CTLBOX%(223),GEARS1%(263),CTLBOX1%(223)
  10. SCREEN 2,320,200,5,1
  11. WINDOW 2,"The Mouse Factory",(0,0)-(311,186),0,2
  12. GET (100,100)-(110,110),BLUE%
  13. TITLE=0
  14. GOSUB FACTORYPIC
  15. TITLE=1
  16. COLOR 10,0
  17. LOCATE 18,14
  18. PRINT "by Mike Mead"
  19. LINE (100,164)-(204,178),17,B
  20. LINE (101,165)-(203,177),10,B
  21. FOR I=1 TO 50
  22.  LINE (152-I,166)-(152+I,176),11,BF
  23. NEXT I 
  24. COLOR 2,11
  25. LOCATE 22,14 : PRINT "Loading Data"
  26. COLOR 1,0
  27. OPEN ":MICKEY.DAT" FOR INPUT AS #1
  28. FOR I=0 TO 5
  29.  FOR J=0 TO 203
  30.   INPUT#1,MICKEY%(J,I)
  31.  NEXT J
  32. NEXT I
  33. CLOSE #1
  34. COLOR 2,5
  35. LOCATE 22,14 : PRINT "Loading Data"
  36. OPEN ":GEARS.DAT" FOR INPUT AS #1
  37. INPUT#1,L
  38. FOR I=0 TO L
  39.  INPUT#1,GEARS%(I)
  40. NEXT 
  41. CLOSE #1
  42. COLOR 2,6
  43. LOCATE 22,14 : PRINT "Loading Data"
  44. OPEN ":CTLBOX.DAT" FOR INPUT AS #1
  45. INPUT#1,L
  46. FOR I=0 TO L
  47.  INPUT#1,CTLBOX%(I)
  48. NEXT 
  49. CLOSE #1
  50. COLOR 2,9
  51. LOCATE 22,14 : PRINT "Loading Data"
  52. FOR J=0 TO 2
  53.  IF J=0 THEN OPEN ":CIRBOX.DAT" FOR INPUT AS #1
  54.  IF J=1 THEN OPEN ":TRIBOX.DAT" FOR INPUT AS #1
  55.  IF J=2 THEN OPEN ":SQUBOX.DAT" FOR INPUT AS #1
  56.  INPUT#1,L
  57.  FOR I=0 TO L
  58.   INPUT#1,BOX%(I,J)
  59.  NEXT I
  60.  CLOSE #1
  61. NEXT J 
  62. COLOR 2,19
  63. LOCATE 22,14 : PRINT "Loading Data"
  64. OPEN ":HOOK.DAT" FOR INPUT AS #1
  65. INPUT#1,L
  66. FOR I=0 TO L
  67.  INPUT#1,HOOK%(I)
  68. NEXT 
  69. CLOSE #1
  70. COLOR 2,11
  71. LOCATE 22,14 : PRINT "Loading Data"
  72. OPEN ":RL.DAT" FOR INPUT AS #1
  73. INPUT#1,L
  74. FOR I=0 TO L
  75.  INPUT#1,RL%(I)
  76. NEXT 
  77. CLOSE #1
  78. COLOR 2,5
  79. LOCATE 22,14 : PRINT "Loading Data"
  80. OPEN ":RR.DAT" FOR INPUT AS #1
  81. INPUT#1,L
  82. FOR I=0 TO L
  83.  INPUT#1,RR%(I)
  84. NEXT 
  85. CLOSE #1
  86. COLOR 2,6
  87. LOCATE 22,14 : PRINT "Loading Data"
  88. OPEN ":LL.DAT" FOR INPUT AS #1
  89. INPUT#1,L
  90. FOR I=0 TO L
  91.  INPUT#1,LL%(I)
  92. NEXT 
  93. CLOSE #1
  94. COLOR 2,9
  95. LOCATE 22,14 : PRINT "Loading Data"
  96. OPEN ":TOPBOX.DAT" FOR INPUT AS #1
  97. INPUT#1,L
  98. FOR I=0 TO L
  99.  INPUT#1,TOPBOX%(I)
  100. NEXT 
  101. CLOSE #1
  102. COLOR 2,14
  103. LOCATE 22,14 : PRINT "Loading Data"
  104. OPEN ":MIDBOX.DAT" FOR INPUT AS #1
  105. INPUT#1,L
  106. FOR I=0 TO L
  107.  INPUT#1,MIDBOX%(I)
  108. NEXT 
  109. CLOSE #1
  110. COLOR 2,19
  111. LOCATE 22,14 : PRINT "Loading Data"
  112. OPEN ":BOTBOX.DAT" FOR INPUT AS #1
  113. INPUT#1,L
  114. FOR I=0 TO L
  115.  INPUT#1,BOTBOX%(I)
  116. NEXT 
  117. CLOSE #1
  118. FOR I=0 TO 7
  119.  LINE (100+I,164+I)-(204-I,178-I),8,B
  120. NEXT I
  121. GOSUB FACTORYPIC
  122. GET (278,6)-(307,30),GEARS1%
  123. GET (283,44)-(305,63),CTLBOX1%
  124. GET (0,36)-(62,67),TBOX%
  125. GET (1,71)-(63,102),MBOX%
  126. GET (0,106)-(62,137),BBOX%
  127. CYCLE=0 : GOTBOX=0 : READY=0 : SET=0 : GO=0 : DONE=0
  128. LVR1=0 : LVR2=0 : LVR3=0 : LVR4=0
  129. SPEED=3 : S=1
  130. OLDX=97 : OLDY=97
  131. DX=0 : DY=0
  132. X=97 : Y=97
  133. CURCHAR=0
  134. OLDCHAR=0
  135. PUT (X,Y),MICKEY%(0,CURCHAR)
  136. GOSUB RING
  137. LOOP:
  138.  S=S*-1
  139.  S2=STICK(2) : S3=STICK(3)
  140.  IF S2=0 AND S3=0 THEN
  141.   JOY=STRIG(3)
  142.   WHILE STRIG(3)<>0 : WEND
  143.   IF JOY=-1 THEN
  144.    IF CYCLE=0 THEN GOSUB STARTCYCLE : GOTO LOOP
  145.    IF X>=220 AND GOTBOX=0 AND READY=0 AND CYCLE=1 AND Y>=110 AND Y<130 THEN
  146.     GOTBOX=1
  147.     PUT (240,120),BACKGROUND%,PSET
  148.     PUT (X+18,Y),BOX%(0,TYPE)
  149.     FOR I=1380 TO 1400 
  150.      SOUND I,.2,255,0
  151.     NEXT
  152.    END IF
  153.    IF X>=207 AND GOTBOX=1 AND Y>=46 AND Y<=58 THEN
  154.     PUT (X+18,Y),BOX%(0,TYPE)
  155.     GET (230,47)-(230+21,47+25),BACKGROUND%
  156.     PUT (230,47),BOX%(0,TYPE),PSET
  157.     FOR I=820 TO 800 STEP-1
  158.      SOUND I,.2,255,0
  159.     NEXT
  160.     GOTBOX=0
  161.     READY=1
  162.    END IF
  163.    IF X<=66 THEN
  164.     IF Y>=40 AND Y<44 THEN
  165.      IF LVR1=0 THEN
  166.       FLAG=-1
  167.       PUT (48,51),LL%,PSET
  168.       PUT (0,36),TOPBOX%,PSET
  169.       LVR1=1
  170.       FOR I=1400 TO 1300 STEP -4
  171.        SOUND I,.2,255,0
  172.        IF FLAG=-1 THEN 
  173.         PUT (280,43),CTLBOX%,PSET
  174.        ELSE
  175.         PUT (283,44),CTLBOX1%,PSET
  176.        END IF
  177.        FLAG=FLAG*-1
  178.       NEXT 
  179.       IF GO=1 THEN
  180.        PUT (28,16),BACKGROUND%,PSET
  181.        PUT (28,16),BOX%(0,TYPE)
  182.        FOR I=17 TO 45
  183.         PUT (28,I-1),BOX%(0,TYPE)
  184.         PUT (28,I),BOX%(0,TYPE)
  185.         SOUND 1330-I*2,.4,255,0
  186.        NEXT
  187.        PUT (28,45),BOX%(0,TYPE)
  188.        GET (28,45)-(28+21,45+25),BACKGROUND%
  189.        PUT (28,45),BOX%(0,TYPE),PSET
  190.        GO=0
  191.        DONE=1
  192.       END IF
  193.      ELSE
  194.       IF DONE=1 THEN
  195.        PUT (28,45),BACKGROUND%,PSET
  196.        CYCLE=0
  197.        DONE=0
  198.        IF TYPE<>1 THEN 
  199.         Wrong=1
  200.        ELSE
  201.         Right=1
  202.        END IF
  203.       END IF
  204.       FOR I=1 TO 5
  205.        SOUND 600,.1,255,0
  206.       NEXT
  207.       PUT (0,36),TBOX%,PSET
  208.       LVR1=0
  209.      END IF
  210.     END IF
  211.     IF Y>=69 AND Y<80 THEN
  212.      IF LVR2=0 THEN
  213.       PUT (49,86),LL%,PSET
  214.       PUT (1,71),MIDBOX%,PSET
  215.       LVR2=1
  216.       FLAG=-1
  217.       FOR I=1400 TO 1300 STEP -4
  218.        SOUND I,.2,255,0
  219.        IF FLAG=-1 THEN 
  220.         PUT (280,43),CTLBOX%,PSET
  221.        ELSE
  222.         PUT (283,44),CTLBOX1%,PSET
  223.        END IF
  224.        FLAG=FLAG*-1
  225.       NEXT 
  226.       IF GO=1 THEN
  227.        PUT (28,16),BACKGROUND%,PSET
  228.        PUT (28,16),BOX%(0,TYPE)
  229.        FOR I=17 TO 80
  230.         PUT (28,I-1),BOX%(0,TYPE)
  231.         PUT (28,I),BOX%(0,TYPE)
  232.         SOUND 1330-I*2,.3,255,0
  233.        NEXT
  234.        PUT (28,80),BOX%(0,TYPE)
  235.        GET (28,80)-(28+21,80+25),BACKGROUND%
  236.        PUT (28,80),BOX%(0,TYPE),PSET
  237.        GO=0
  238.        DONE=1
  239.       END IF
  240.      ELSE
  241.       IF DONE=1 THEN
  242.        PUT (28,80),BACKGROUND%,PSET
  243.        CYCLE=0
  244.        DONE=0
  245.        IF TYPE<>2 THEN 
  246.         Wrong=1
  247.        ELSE
  248.         Right=1
  249.        END IF
  250.       END IF
  251.       FOR I=1 TO 5
  252.        SOUND 600,.1,255,0
  253.       NEXT
  254.       PUT (1,71),MBOX%,PSET
  255.       LVR2=0
  256.      END IF
  257.     END IF
  258.     IF Y>=104 AND Y<115 THEN
  259.      IF LVR3=0 THEN
  260.       PUT (48,121),LL%,PSET
  261.       PUT (0,106),BOTBOX%,PSET
  262.       LVR3=1
  263.       FLAG=-1
  264.       FOR I=1400 TO 1300 STEP -4
  265.        SOUND I,.2,255,0
  266.        IF FLAG=-1 THEN 
  267.         PUT (280,43),CTLBOX%,PSET
  268.        ELSE
  269.         PUT (283,44),CTLBOX1%,PSET
  270.        END IF
  271.        FLAG=FLAG*-1
  272.       NEXT 
  273.       IF GO=1 THEN
  274.        PUT (28,16),BACKGROUND%,PSET
  275.        PUT (28,16),BOX%(0,TYPE)
  276.        FOR I=17 TO 115
  277.         PUT (28,I-1),BOX%(0,TYPE)
  278.         PUT (28,I),BOX%(0,TYPE)
  279.         SOUND 1330-I*2,.3,255,0
  280.        NEXT
  281.        PUT (28,115),BOX%(0,TYPE)
  282.        GET (28,115)-(28+21,115+25),BACKGROUND%
  283.        PUT (28,115),BOX%(0,TYPE),PSET
  284.        GO=0
  285.        DONE=1
  286.       END IF
  287.      ELSE
  288.       IF DONE=1 THEN
  289.        PUT (28,115),BACKGROUND%,PSET
  290.        CYCLE=0
  291.        DONE=0
  292.        IF TYPE<>0 THEN 
  293.         Wrong=1
  294.        ELSE
  295.         Right=1
  296.        END IF
  297.       END IF
  298.       FOR I=1 TO 5
  299.        SOUND 600,.1,255,0
  300.       NEXT
  301.       PUT (0,106),BBOX%,PSET
  302.       LVR3=0
  303.      END IF
  304.     END IF
  305.    END IF
  306.    IF X=201 THEN
  307.     IF Y>=58 AND Y<74 THEN
  308.      IF LVR4=0 THEN
  309.       PUT (220,79),RR%,PSET
  310.       LVR4=1
  311.       IF READY=1 THEN
  312.        PUT (230,47),BACKGROUND%,PSET
  313.        PUT (230,47),BOX%(0,TYPE) : T=0
  314.        FLAG=-1
  315.        FOR I=46 TO 16 STEP-1
  316.         IF FLAG=-1 THEN 
  317.          PUT (278,6),GEARS%,PSET
  318.          PUT (280,43),CTLBOX%,PSET
  319.         ELSE
  320.          PUT (278,6),GEARS1%,PSET
  321.          PUT (283,44),CTLBOX1%,PSET
  322.         END IF
  323.         FLAG=FLAG*-1
  324.         PUT (230,I+1),BOX%(0,TYPE)
  325.         PUT (230,I),BOX%(0,TYPE)
  326.         SOUND 1000+T,.2,255,0 : T=T+2
  327.         IF I<25 THEN PUT (233,40),BLUE%,PSET
  328.        NEXT
  329.        PUT (230,16),BOX%(0,TYPE)
  330.        GET (230,16)-(230+21,16+25),BACKGROUND%
  331.        PUT (230,16),BOX%(0,TYPE),PSET
  332.        READY=0
  333.        SET=1
  334.       END IF
  335.      ELSE
  336.       PUT (220,79),RL%,PSET
  337.       LVR4=0
  338.       FLAG=-1
  339.       IF SET=1 THEN
  340.        PUT (230,16),BACKGROUND%,PSET
  341.        FOR I=228 TO 28 STEP -2
  342.         IF FLAG=-1 THEN 
  343.          PUT (278,6),GEARS%,PSET
  344.          PUT (280,43),CTLBOX%,PSET
  345.         ELSE
  346.          PUT (278,6),GEARS1%,PSET
  347.          PUT (283,44),CTLBOX1%,PSET
  348.         END IF
  349.         FLAG=FLAG*-1
  350.         PUT (I+2,16),BACKGROUND%,PSET
  351.         GET (I,16)-(I+21,16+25),BACKGROUND%
  352.         PUT (I,16),BOX%(0,TYPE),PSET
  353.         SOUND 200,.1,255,0
  354.        NEXT
  355.        PUT (278,6),GEARS1%,PSET
  356.        PUT (283,44),CTLBOX1%,PSET
  357.        SET=0
  358.        GO=1
  359.       END IF
  360.      END IF
  361.     END IF
  362.    END IF
  363.    IF Wrong=1 THEN GOSUB BUZZ
  364.    IF Right=1 THEN GOSUB RING
  365.    IF OLDCHAR>=3 THEN
  366.     OLDCHAR=CURCHAR
  367.     CURCHAR=4
  368.     IF OLDCHAR=CURCHAR THEN LOOP
  369.    END IF
  370.    IF OLDCHAR<=2 THEN
  371.     OLDCHAR=CURCHAR
  372.     CURCHAR=1
  373.     IF OLDCHAR=CURCHAR THEN LOOP
  374.    END IF
  375.   END IF
  376.   IF JOY=0 THEN   
  377.    A$=INKEY$
  378.    IF A$=CHR$(27) THEN QUIT
  379.    DX=0
  380.    DY=0
  381.    OLDCHAR=CURCHAR
  382.    IF OLDCHAR>=3 THEN
  383.     CURCHAR=3
  384.     IF CURCHAR=OLDCHAR THEN LOOP
  385.    END IF
  386.    IF OLDCHAR<=2 THEN
  387.     CURCHAR=0
  388.     IF CURCHAR=OLDCHAR THEN LOOP
  389.    END IF
  390.   END IF
  391.  END IF
  392.  IF S2=0 AND S3=1 THEN
  393.   DX=0
  394.   DY=1
  395.   OLDCHAR=CURCHAR
  396.   IF OLDCHAR>=3 THEN
  397.    IF S>0 THEN
  398.     CURCHAR=4
  399.    ELSE
  400.     CURCHAR=5
  401.    END IF
  402.   END IF
  403.   IF OLDCHAR<=2 THEN
  404.    IF S>0 THEN 
  405.     CURCHAR=1
  406.    ELSE
  407.     CURCHAR=2
  408.    END IF
  409.   END IF  
  410.  END IF
  411.  IF S2=0 AND S3=-1 THEN
  412.   DX=0
  413.   DY=-1
  414.   OLDCHAR=CURCHAR
  415.   IF OLDCHAR>=3 THEN
  416.    IF S>0 THEN
  417.     CURCHAR=4
  418.    ELSE
  419.     CURCHAR=5
  420.    END IF
  421.   END IF
  422.   IF OLDCHAR<=2 THEN
  423.    IF S>0 THEN 
  424.     CURCHAR=1
  425.    ELSE
  426.     CURCHAR=2
  427.    END IF
  428.   END IF  
  429.  END IF
  430.  IF S2=1 AND S3=0 THEN
  431.   DX=1
  432.   DY=0
  433.   OLDCHAR=CURCHAR
  434.   IF S>0 THEN
  435.    CURCHAR=1
  436.   ELSE
  437.    CURCHAR=2
  438.   END IF
  439.  END IF
  440.  IF S2=1 AND S3=1 THEN
  441.   DX=1
  442.   DY=1
  443.   OLDCHAR=CURCHAR
  444.   IF S>0 THEN
  445.    CURCHAR=1
  446.   ELSE
  447.    CURCHAR=2
  448.   END IF
  449.  END IF
  450.  IF S2=1 AND S3=-1 THEN
  451.   DX=1
  452.   DY=-1
  453.   OLDCHAR=CURCHAR
  454.   IF S>0 THEN
  455.    CURCHAR=1
  456.   ELSE
  457.    CURCHAR=2
  458.   END IF
  459.  END IF
  460.  IF S2=-1 AND S3=0 THEN
  461.   DX=-1
  462.   DY=0
  463.   OLDCHAR=CURCHAR
  464.   IF S>0 THEN 
  465.    CURCHAR=4
  466.   ELSE
  467.    CURCHAR=5
  468.   END IF
  469.  END IF
  470.  IF S2=-1 AND S3=1 THEN
  471.   DX=-1
  472.   DY=1
  473.   OLDCHAR=CURCHAR
  474.   IF S>0 THEN 
  475.    CURCHAR=4
  476.   ELSE
  477.    CURCHAR=5
  478.   END IF
  479.  END IF
  480.  IF S2=-1 AND S3=-1 THEN
  481.   DX=-1
  482.   DY=-1
  483.   OLDCHAR=CURCHAR
  484.   IF S>0 THEN 
  485.    CURCHAR=4
  486.   ELSE
  487.    CURCHAR=5
  488.   END IF
  489.  END IF
  490. PLACE:
  491.  IF S>0 THEN 
  492.   SOUND 800,.05,255,0
  493.  ELSE
  494.   SOUND 500,.05,255,0
  495.  END IF
  496.  OLDX=X
  497.  OLDY=Y
  498.  X=X+DX*SPEED
  499.  Y=Y+DY*SPEED
  500.  IF Y<40 THEN Y=40
  501.  IF Y>132 THEN Y=132
  502.  IF X<=80 THEN
  503.   IF ((Y>=40 AND Y<46) OR (Y>=69 AND Y<80) OR (Y>=104 AND Y<115)) AND X<65 THEN X=65
  504.   IF ((Y>=46 AND Y<69) OR (Y>=80 AND Y<104) OR (Y>=115 AND Y<132))  AND X<76 THEN X=76
  505.  END IF
  506.  IF X>180 THEN
  507.   IF (Y>=97 AND Y<=132) AND X>221 THEN X=221
  508.   IF (Y>=76 AND Y<97) AND X>188 THEN X=188
  509.   IF (Y>=59 AND Y<76) AND X>201 THEN X=201
  510.   IF (Y>=40 AND Y<59) AND X>208 THEN X=208
  511.  END IF 
  512.  PUT (OLDX,OLDY),MICKEY%(0,OLDCHAR)
  513.  PUT (X,Y),MICKEY%(0,CURCHAR)
  514.  IF GOTBOX=1 THEN
  515.   PUT (OLDX+18,OLDY),BOX%(0,TYPE)
  516.   PUT (X+18,Y),BOX%(0,TYPE)
  517.  END IF
  518.  GOTO LOOP
  519.  
  520. STARTCYCLE:
  521.  TYPE=INT(RND(TIMER)*3)
  522.  PUT (237,15),HOOK%,PSET
  523.  PUT (0,36),TBOX%,PSET
  524.  PUT (1,71),MBOX%,PSET
  525.  PUT (0,106),BBOX%,PSET
  526.  PUT (301,100),BOX%(0,TYPE)
  527.  FOR BX=300 TO 250 STEP-1
  528.   SOUND 2000,.3,255,0
  529.   PUT (BX+1,100),BOX%(0,TYPE)
  530.   PUT (BX,100),BOX%(0,TYPE)
  531.  NEXT
  532.  BY=102
  533.  FOR BX=249 TO 240 STEP-1
  534.   SOUND 1000,.3,255,0
  535.   PUT (BX+1,BY-2),BOX%(0,TYPE)
  536.   PUT (BX,BY),BOX%(0,TYPE)
  537.   BY=BY+2
  538.  NEXT
  539.  PUT (240,120),BOX%(0,TYPE)
  540.  GET (240,120)-(240+21,120+25),BACKGROUND%
  541.  PUT (240,120),BOX%(0,TYPE),PSET
  542.  CYCLE=1
  543.  RETURN
  544.   
  545. RING:
  546.  Right=0
  547.  SOUND WAIT
  548.   SOUND 261.63,4,255,0
  549.   SOUND 523.25,4,255,1
  550.  SOUND RESUME
  551.  FOR I=1 TO 800 : NEXT
  552.  SOUND WAIT
  553.   SOUND 1046.46,6,255,2
  554.   SOUND 2092.84,4,255,3
  555.  SOUND RESUME
  556.  FOR I=1 TO 800 : NEXT
  557.  SOUND WAIT
  558.   SOUND 261.63,4,255,0
  559.   SOUND 523.25,4,255,1
  560.   SOUND 1046.46,4,255,2
  561.   SOUND 2092.84,4,255,3
  562.  SOUND RESUME 
  563.  RETURN
  564.  
  565. BUZZ:
  566.  FOR I=1 TO 1000 : NEXT
  567.  Wrong=0
  568.  FOR I=1 TO 70
  569.   SOUND 1300,.1,255,0
  570.   SOUND 900,.1,255,1
  571.  NEXT I
  572.  RETURN
  573.   
  574.  
  575. QUIT:
  576. WINDOW CLOSE 2
  577. SCREEN CLOSE 2
  578. SYSTEM
  579. END
  580.  
  581. REM - LoadACBM
  582. REM -  by Carolyn Scheppner  CBM  04/86
  583. FACTORYPIC:
  584. IF TITLE=1 THEN GetNames
  585. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  586. DECLARE FUNCTION xOpen&  LIBRARY
  587. DECLARE FUNCTION xRead&  LIBRARY
  588. DECLARE FUNCTION xWrite& LIBRARY
  589. DECLARE FUNCTION AllocMem&() LIBRARY
  590. PRINT "Looking for Libraries...."
  591. LIBRARY ":dos.library"
  592. PRINT "Found dos.bmap"
  593. LIBRARY ":exec.library"
  594. PRINT "Found exec.bmap"
  595. LIBRARY ":graphics.library"
  596. PRINT "Found graphics.bmap"
  597. GetNames:
  598. IF TITLE=0 THEN ACBMname$=":factoryTITLE.ACBM"
  599. IF TITLE=1 THEN ACBMname$=":factory.ACBM"
  600. loadError$ = ""
  601. ' CLS
  602. GOSUB LoadACBM
  603. IF loadError$ <> "" THEN GOTO QUIT
  604. Mcleanup:
  605. Mcleanup2:
  606. IF TITLE=1 THEN LIBRARY CLOSE
  607. IF loadError$ <> "" THEN PRINT loadError$
  608. RETURN
  609.  
  610. LoadACBM:
  611. F$ = ACBMname$
  612. fHandle& = 0
  613. mybuf& = 0
  614. foundBMHD = 0
  615. foundCMAP = 0
  616. foundCAMG = 0
  617. foundCCRT = 0
  618. foundABIT = 0
  619. filename$ = F$ + CHR$(0)
  620. fHandle& = xOpen&(SADD(filename$),1005)
  621. IF fHandle& = 0 THEN
  622.    loadError$ = "Can't open/find pic file"
  623.    GOTO Lcleanup
  624. END IF
  625. ClearPublic& = 65537&
  626. mybufsize& = 360
  627. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  628. IF mybuf& = 0 THEN
  629.    loadError$ = "Can't alloc buffer"
  630.    GOTO Lcleanup
  631. END IF
  632. inbuf& = mybuf&
  633. cbuf& = mybuf& + 120
  634. ctab& = mybuf& + 240
  635. rLen& = xRead&(fHandle&,inbuf&,12)
  636. tt$ = ""
  637. FOR kk = 8 TO 11
  638.    tt% = PEEK(inbuf& + kk)
  639.    tt$ = tt$ + CHR$(tt%)
  640. NEXT
  641. IF tt$ <> "ACBM" THEN 
  642.    loadError$ = "Not an ACBM pic file"
  643.    GOTO Lcleanup
  644. END IF
  645. ChunkLoop:
  646.  rLen& = xRead&(fHandle&,inbuf&,8)
  647.  icLen& = PEEKL(inbuf& + 4)
  648.  tt$ = ""
  649.  FOR kk = 0 TO 3
  650.     tt% = PEEK(inbuf& + kk)
  651.     tt$ = tt$ + CHR$(tt%)
  652.  NEXT   
  653. IF tt$ = "BMHD" THEN  'BitMap header 
  654.    foundBMHD = 1
  655.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  656.    iWidth%  = PEEKW(inbuf&)
  657.    iHeight% = PEEKW(inbuf& + 2)
  658.    iDepth%  = PEEK(inbuf& + 8)  
  659.    iCompr%  = PEEK(inbuf& + 10)
  660.    scrWidth%  = PEEKW(inbuf& + 16)
  661.    scrHeight% = PEEKW(inbuf& + 18)
  662.  
  663.    iRowBytes% = iWidth% /8
  664.    scrRowBytes% = scrWidth% / 8
  665.    nColors%  = 2^(iDepth%)
  666.  
  667.    REM - Enough free ram to display ?
  668.    AvailRam& = FRE(-1)
  669.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  670.    IF AvailRam& < NeededRam& THEN
  671.       loadError$ = "Not enough free ram."
  672.       GOTO Lcleanup
  673.    END IF
  674.  
  675.    kk = 1
  676.    IF scrWidth% > 320 THEN kk = kk + 1
  677.    IF scrHeight% > 200  THEN kk = kk + 2
  678.    REM - Get addresses of structures
  679.    GOSUB GetScrAddrs
  680.  
  681.    REM - Black out screen
  682.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  683.  
  684.  
  685. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  686.    foundCMAP = 1
  687.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  688.  
  689.    REM - Build Color Table
  690.    FOR kk = 0 TO nColors% - 1
  691.       red% = PEEK(cbuf&+(kk*3))
  692.       gre% = PEEK(cbuf&+(kk*3)+1)
  693.       blu% = PEEK(cbuf&+(kk*3)+2)
  694.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  695.       POKEW(ctab&+(2*kk)),regTemp%
  696.    NEXT
  697.  
  698.  
  699. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  700.    foundCAMG = 1
  701.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  702.    camgModes& = PEEKL(inbuf&)
  703.  
  704.  
  705. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  706.    foundCCRT = 1
  707.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  708.    ccrtDir%    = PEEKW(inbuf&)
  709.    ccrtStart%  = PEEK(inbuf& + 2)
  710.    ccrtEnd%    = PEEK(inbuf& + 3)
  711.    ccrtSecs&   = PEEKL(inbuf& + 4)
  712.    ccrtMics&   = PEEKL(inbuf& + 8)
  713.  
  714.  
  715. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  716.    foundABIT = 1
  717.  
  718.    REM - This only handles full size BitMaps, not brushes
  719.    REM - Very fast - reads in entire BitPlanes
  720.    plSize& = (scrWidth%/8) * scrHeight%
  721.    FOR pp = 0 TO iDepth% -1
  722.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  723.    NEXT
  724.  
  725.  
  726. ELSE 
  727.    REM - Reading unknown chunk  
  728.    FOR kk = 1 TO icLen&
  729.       rLen& = xRead&(fHandle&,inbuf&,1)
  730.    NEXT
  731.    REM - If odd length, read 1 more byte
  732.    IF (icLen& OR 1) = icLen& THEN 
  733.       rLen& = xRead&(fHandle&,inbuf&,1)
  734.    END IF
  735.       
  736. END IF
  737.  
  738.  
  739. REM - Done if got all chunks 
  740. IF foundBMHD AND foundCMAP AND foundABIT THEN
  741.    GOTO GoodLoad
  742. END IF
  743.  
  744. REM - Good read, get next chunk
  745. IF rLen& > 0 THEN GOTO ChunkLoop
  746.  
  747. IF rLen& < 0 THEN  'Read error
  748.    loadError$ = "Read error"
  749.    GOTO Lcleanup
  750. END IF   
  751.  
  752. REM - rLen& = 0 means EOF
  753. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  754.    loadError$ = "Needed ILBM chunks not found"
  755.    GOTO Lcleanup
  756. END IF
  757.  
  758.  
  759. GoodLoad:
  760. loadError$ =""
  761.  
  762. REM  Load proper Colors
  763. IF foundCMAP THEN 
  764.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  765. END IF
  766.  
  767. Lcleanup:
  768. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  769. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  770.  
  771. RETURN
  772.  
  773.  
  774. GetScrAddrs:
  775. REM - Get addresses of screen structures
  776.    sWindow&   = WINDOW(7)
  777.    sScreen&   = PEEKL(sWindow& + 46)
  778.    sViewPort& = sScreen& + 44
  779.    sRastPort& = sScreen& + 84
  780.    sColorMap& = PEEKL(sViewPort& + 4)
  781.    colorTab&  = PEEKL(sColorMap& + 4)
  782.    sBitMap&   = PEEKL(sRastPort& + 4)
  783.  
  784.    REM - Get screen parameters
  785.    scrWidth%  = PEEKW(sScreen& + 12)
  786.    scrHeight% = PEEKW(sScreen& + 14)
  787.    scrDepth%  = PEEK(sBitMap& + 5)
  788.    nColors%   = 2^scrDepth%
  789.  
  790.    REM - Get addresses of Bit Planes 
  791.    FOR kk = 0 TO scrDepth% - 1
  792.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  793.    NEXT
  794. RETURN
  795.  
  796.  
  797.